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-- file Pass4B.Mesa 

-- last modified by Satterthwaite, July 17. 1978 10:34 AM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
BcdDefs: FROM "bcddefs", 
ComData: FROM "comdata", 
CompilerDefs: FROM "compilerdef s" , 
CopierDefs: FROM "copierdef s" . 
ErrorDefs: FROM "errordefs", 
P4Defs: FROM "p4defs". 
StreamDefs: FROM "streamdef s" . 
StringDefs: FROM "stringdef s" , 
SymDefs: FROM "symdefs", 
SymTabDefs: FROM "symtabdef s'\ 
SystemDefs: FROM "systemdef s" . 
TableDefs: FROM "tabledefs". 
TreeDefs: FROM "treedefs". 
TypePackDefs: FROM "typepackdef s" ; 

Pass4B: PROGRAM 
IMPORTS 

CompilerDefs, CopierDefs, ErrorDefs, P4Defs, StringDefs, SymTabDefs, 
SystemDefs, TreeDefs, TypePackDefs, 
dataPtr: ComData 
EXPORTS P4Defs = 
BEGIN 
OPEN SymTabDefs, SymDefs; 

tb: TableDefs. TableBase; -- tree base address (local copy) 

seb: TableDefs .TableBase; -- se table base address (local copy) 

ctxb: TableDefs. TableBase; -- context table base address (local copy) 

mdb: TableDefs. TableBase; -- body table base address (local copy) 

bb: TableDefs. TableBase; -- body table base address (local copy) 

BCDNotify: PUBLIC TableDefs .TableNotifier « 

BEGIN -- called by allocator whenever table area is repacked 

tb ^ base[TreeDef s.treetype]; 

seb ♦- base[setype] ; ctxb ♦- base[ctxtype]; mdb ^ base[mdtype]; 

bb <r base[bodytype]; RETURN 

END; 

-- shared variables 

bcdHeader: POINTER TO BcdDefs. BCD; 
bcdOffset, mtOffset: CARDINAL; 

nString: BcdDefs .NameString; 

firstPorted: MDIndex = FIRST[MDIndex] + SIZE[MDRecord]; 

lastPorted: MDIndex; -- im/exported files in [firstPorted. . lastPorted) 

-- service routines 

GFTIndex: TYPE « BcdDefs .GFTIndex; 
EPIndex: TYPE - BcdDefs .EPIndex; 
EPLimit: CARDINAL = LAST[EPIndex]+l ; 
ControlLink: TYPE = BcdDefs .ControlLink; 

OwnGfi: GFTIndex = 1; 

GFSlots: PROCEDURE [epMax: EPIndex] RETURNS [nGfi: [1..4]] » 
BEGIN 

nGfi <- epMax/EPLimit + 1; RETURN 
END; 

MakeEPLink: PUBLIC PROCEDURE [ep: CARDINAL, gfi: GFTIndex] RETURNS [ControlLink] 
BEGIN 
RETURN [ControlLink[procedure[ 

tag: procedure, 

ep: ep MOD EPLimit, 

gfi: gfi + ep/EPLimit]]] 
END; 

MakeFrameLink: PROCEDURE [ep: CARDINAL, gfi: GFTIndex] RETURNS [ControlLink] « 
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BEGIN 

RETURN [Contro1Link[procedure[ 

tag: frame, 

ep: ep MOD EPLimit, 

gfi: gfi + ep/EPLimit]]] 
END; 

RelocateEPLink: PROCEDURE [link: ControlLink, offset: CARDINAL] RETURNS [Control Link] 
BEGIN 

IF link. gfi # BcdDef s.GFTNull THEN link. gfi ^ link. gfi + offset; 
RETURN [link] 
END; 

PortedFile: PROCEDURE [ctx: CTXIndex] RETURNS [fti: BcdDef s.FTIndex] - 
BEGIN 

mdi: MDIndex; 
n: CARDINAL; 

mdi ^ WITH c: (ctxb+ctx) SELECT FROM 
included «> c.ctxmodule. 

imported => (ctxb+c. includeLink) .ctxmodule, 
ENDCASE => OwnMdi; 
IF mdi » OwnMdi 

THEN fti ^ BcdDefs.FTSelf 
ELSE 
BEGIN 
IF mdi IN [firstPorted .. lastPorted) 

THEN n <- LOOPHOLE[mdi-firstPorted, CARDINAL]/SIZE[MDRecord] 
ELSE 
BEGIN 

n <- LOOPHOLE[lastPorted-firstPorted, CARDINAL]/SIZE[MDRecord]; 
SwapMdi[mdi, lastPorted]; 
lastPorted <- lastPorted + SIZE[MDRecord]; 
END; 
fti <- LOOPHOLE[n*SIZE[BcdDefs.FTRecord]]; 
END; 
RETURN 
END; 

SwapMdi: PROCEDURE [mdil. mdi2: MDIndex] » 
BEGIN 

ctx: includedCTXIndex; 
t: MDRecord; 
IF mdil # mdi2 
THEN 
BEGIN 
FOR ctx <- (mdb+mdil).mdctx, (ctxb+ctx) .ctxchain UNTIL ctx « CTXNull 

DO (ctxb+ctx). ctxmodule <- mdi2 ENDLOOP; 
FOR ctx ♦- (mdb+mdi2).mdctx. (ctxb+ctx) .ctxchain UNTIL ctx « CTXNull 

DO (ctxb+ctx) .ctxmodule ♦- mdil ENDLOOP; 
t <- (mdb+mdil)t; (mdb+mdil)t ^ (mdb+mdi2)t; (mdb+mdi2)t 4- t; 
END; 
RETURN 
END; 

Substring: TYPE = StringDefs .Substring; 
SubStringDescriptor: TYPE = StringDefs .SubStringDescriptor; 

Enterld: PROCEDURE [id: Substring, ignoreCase: BOOLEAN] RETURNS [BcdDef s .NameRecord] « 
BEGIN 

i: CARDINAL; 

desc: SubStringDescriptor; 
s: Substring « @desc; 
t: BcdDef s .NameString; 
i ^ 0; s.base *- §nString. string; 
UNTIL i « nString. string. length 
DO 

s. offset 4- i <- i + l; s. length *- nString.size[i]; 
IF (IF ignoreCase 

THEN StringDefs .EquivalentSubStrings 
ELSE StringDefs. EqualSubStrings)[id. s] 
THEN EXIT; 
i 4- i + s. length; 
REPEAT 

FINISHED »> 
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BEGIN 

IF nString. string. length + (id. length+1) > nString. string. maxlength 
THEN 

BEGIN -- rewrite if nString is in table area 
t <- LOOPHOLE[SysteniD0fs.AnocateHeapString[ 

nString. string. maxlength + MAX[( id . length+1) , 32]]]; 
S tringDefs.App ends tring[6t. string, OnString. string]; 
SystemDefs.FreeHeapString[@nString. string]; nString ♦- t; 
END; 
i ^ nString. string. length ♦- nString. string. length + 1; 
nString. size[i] ^ id. length; 

StringDef s. AppendSubString[@nString. string, id]; 
END; 
ENDLOOP; 
RETURN [[i]] 
END; 

EnterSymbolId: PROCEDURE [sei: ISEIndex] RETURNS [BcdDef s .NameRecord] ■ 
BEGIN 

s: SubStringDescriptor; 
SubStringForHash[@s, (seb+sei) .htptr]; 
RETURN [Enterld[6s. FALSE]] 
END; 

EnterFileld: PROCEDURE [mdi: MDIndex] RETURNS [BcdDef s .NameRecord] « 
BEGIN 

s, dExt: SubStringDescriptor; 
bed: STRING = ".bed."; 

dBcd: SubStringDescriptor <- [base:bcd, offset:0, length:bcd. length]; 
SubStringForHash[@s, (mdb+mdi) .mdhti] ; 

dExt <- [base: s.base, offset: s .of fset+s . length-bed. length, length: bed. length]; 
IF StringDefs.EquivalentSubStrings[@dExt, (§dBcd] 

THEN s. length ♦- s. length - bed. length; 
RETURN [Enterld[@s, TRUE]] 
END; 

TreeSymbol: PROCEDURE [t: TreeDef s . TreeLink] RETURNS [ISEIndex] « 
BEGIN 
WITH t SELECT FROM 

symbol => RETURN [index]; 

ENDCASE => ERROR; 
END; 

-- relocating imported control links 

Reloeatelmports: PROCEDURE [etx: CTXIndex. gfi: GFTIndex] RETURNS [epMax: EPIndex] 
BEGIN 

sei: ISEIndex; 
epN: CARDINAL; 
epMax <- 0; 

IF etx « CTXNull THEN RETURN; 

FOR sei <- (ctxb+ctx) .selist. NextSe[sei] UNTIL sei « SENull 
DO 

epN <- (seb+sei ). idvalue; 
epMax <r MAX[epMax, epN]; 

(seb+sei) . idvalue ^ SELECT XferMode[(seb+sei) . idtype] FROM 
procedure, signal, error => MakeEPLink[epN, gfi], 
program «> MakeFrameLink[epN, gfi], 
ENDCASE «> BcdDef s.UnboundLink; 
ENDLOOP; 
RETURN 
END; 

Assignlmports: PUBLIC TreeDef s .TreeScan » 
BEGIN 

gfi: GFTIndex; 
savelndex: CARDINAL « dataPtr . textlndex; 

Importltem: TreeDefs .TreeScan ■ 
BEGIN 

node: TreeDef s.Treelndex - TreeDef s .GetNode[t] ; 
sei: ISEIndex « TreeSymbol [(tb+node) . sonl] ; 
type: CSEIndex » UnderType[(seb+sei ). idtype]; 
epMax: EPIndex; 
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dataPtr, textlndex <- (tb+nocle) . info; 
WITH (seb+type) SELECT FROM 
definition ■> 
BEGIN 

IF (ctxb+defCtx).se1ist - SENull 
THEN 

WITH c: (ctxb+defCtx) SELECT FROM 
imported ■> 

IF (tb+node).attrl 

OR ~(mdb+(ctxb+c. includeLink) .ctxmodule) .mdExported 
THEN ErrorDef s .WarningSei[unusedImport, sei]; 
ENDCASE; 
epMax ^ Re1ocateImports[defCtx, gfi]; 
(seb+sei) . idvalue ^ gfi; 
gfi *- gfi + ((seb+sei ). idinfo ^ nGfi); 
-- consider adding GFS1ots[epMax] instead -- 
END; 
pointer ■> 
BEGIN 

(seb+sei) . idvalue ♦- MakeFrameLink[ep:0, gfi:gfi]; 
gfi ^ gfi + 1; 
END; 
ENDCASE; 
(seb+sei) .mark4 <- TRUE; 
RETURN 
END; 

dataPtr.mtRoot.gf i ^ OwnGfi; 

dataPtr.mtRoot.ngf i *- GFSlots[MAX[dataPtr .nBodies, dataPtr.nSigCodes]-!] ; 

gfi ♦- bcdHeader .f irstdummy <- OwnGfi + dataPtr .mtRoot.ngf i ; 

TreeDef s. scanlist[t, Import Item]; 

bcdHeader .nDummies «- gfi - bcdHeader .f irstdummy; 

dataPtr. textlndex ^ savelndex; RETURN 

END; 

-- writing import records 

Processlmports: PUBLIC TreeDef s.TreeScan « 
BEGIN 

-- N.B. nextGfi must be regenerated to match Assignlmports 
nimports: CARDINAL; 
impi: BcdDef s. IMPIndex; 
nextGfi: GFTIndex; 
anyNamed: BOOLEAN; 

Importltem: TreeDef s .TreeScan « 
BEGIN 

node: TreeDef s .Treelndex » TreeDef s .GetNode[t]; 
seil; ISEIndex = TreeSymbol [( tb+node) . sonl]; 
sei2: ISEIndex = TreeSymbol [(tb+irode) . son2] ; 
type: CSEIndex; 
rType: recordCSEIndex; 
entry: BcdDef s. IMPRecord; 
entry <- [ 

name: EnterSymbol Id[sei2], 
port: interface, 

namedinstance: (seb+seil) .htptr ^ (seb+sei2) .htptr, 
file: , 
gfi: . 
ngfi: ]; 
type <- UnderType[( seb+seil) . idtype]; 
WITH (seb+type) SELECT FROM 
definition «> 
BEGIN 

entry. file <- PortedFile[defCtx] ; 
entry. gfi ♦- (seb+seil) . idvalue; 
entry. ngfi <- (seb+seil) . idinfo; 
nextGfi <- (seb+seil) . idvalue + (seb+seil) . idinfo; 
END; 
pointer ■> 
BEGIN 

entry. port <- module; 

rType ^ LOOPHOLE[UnderType[pointedtotype]] ; 
entry. file ♦- PortedFile[( seb+rType) . f ieldctx] ; 
entry. gfi <~ nextGfi; entry. ngfi <- 1; 
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nextGfi ♦- nextGfi + 1; 

END; 
ENDCASE; 
nimports ^ nimports + 1; 

IF entry . namedinstance THEN anyNamed ^ TRUE; 
CompilerDefs.AppendBCDWords [©entry, SIZE[BcdDef s . IMPRecord]]; 
RETURN 
END; 

Nameltem: TreeDef s.TreeScan ■ 
BEGIN 

node: TreeDef s .Treelndex - TreeDefs .GetNode[t]; 
seil: ISEIndex » TreeSymbo1[(tb+node) . sonl]; 
sei2: ISEIndex ■ TreeSymbol[(tb+node) . son2]; 
entry: BcdDefs .NTRecord; 
IF (seb+seil).htptr # (seb+sei2) .htptr 
THEN 
BEGIN 
entry ^ [ 

name: EnterSynibolId[seil] , 
item: BcdDefs .Namee[import[ imp i]]]; 
CompilerDefs.AppendBCDWords [Sentry, SIZE[BcdDefs. NTRecord]]; 
END; 
impi ^ impi + SIZE[BcdDefs. IMPRecord]; 
RETURN 
END; 

offset: CARDINAL; 

bcdHeader. impOffset <- offset ♦- Compi lerDef s .ReadBCDOff set[]; 

nimports <- 0; impi ♦- FIRST[BcdDef s. IMPIndex] ; 

nextGfi +- bcdHeader. firstdummy; anyNamed <- FALSE; 

TreeDefs. scanlist[t. Import Item] ; 

bcdHeader, nimports <- nimports; 

bcdHeader. impLimit <- LOOPHOLE[CompilerDefs .ReadBCDOff set[] -off set]; 

bcdHeader. ntOffset <- offset ^ CompilerDefs. ReadBCDOff set[]; 

IF anyNamed THEN TreeDef s . scan! ist[t , Nameltem]; 

bcdHeader. ntLimit ^ L00PH0LE[Compi1erDef s. ReadBCDOff set[]-off set]; 

RETURN 

END; 

-- writing export records 

Exportid: TreeDef s .TreeMap » 
BEGIN 

type: CSEIndex = P4Def s.OperandType[t]; 
ctx: includedCTXIndex; 
iBase: TypePackOef s .Symbol Tab! eBase; 
id, sei, iSei: ISEIndex; 
ss : StringDefs.SubStringDescriptor; 
hti: HTIndex; 
link: ControlLink; 
header: BcdDefs. EXPRecord; 
nitems: CARDINAL; 
id ^ TreeSymbol[t]; 
WITH v: (seb+type) SELECT FROM 
definition => 

BEGIN ctx <- L00PHOLE[v.defCtx]; 

iBase ^ CopierDef s .GetSymbolTable[(ctxb+ctx) . ctxmodule]; 
IF iBase If NIL 
THEN 
BEGIN 
header <- [ 

name: EnterSymbolId[id], 
size: 0, 

port: interface, 
namedinstance: FALSE, 
file: PortedFile[v.defCtx], 
links: ]; 
FOR iSei <- iBase. FirstCtxSe[(ctxb+ctx) .ctxmap] . 
iBase. NextSe[iSei] UNTIL iSei « SENull 
DO 
IF ~( iBase. seb+iSei) .constant 

THEN header. size <- header, size + 1; 
ENDLOOP; 
CompilerDefs.AppendBCDWords [©header, SIZE[BcdDefs .EXPRecord]]; 
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nltems ♦- 0; 

FOR iSei ^ iBase. FirstCtxSe[(ctxb+ctx) .ctxmap], 
iBase.NextSe[iSei] UNTIL iSei - SENull 
DO 

IF -(iBase. seb+iSei) .constant 
THEN 
BEGIN 

link ^ BcdDefs.NullLink; 

iBase.SubStringForHash[0ss, ( iBase. seb+iSei) .htptr]; 
hti ^ FindString[0ss3; 
IF hti « HTNun 

THEN sei ^ ISENull 
ELSE 
BEGIN 

sei ^ SearchContext[hti , dataPtr.mainCtx]; 
IF sei - SENull 

THEN sei <- SearchContext[hti , dataPtr.moduleCtx]; 
END; 
IF sei ff SENull AND (seb+sei) .publ ic 
THEN 
BEGIN 
IF -(seb+sei) .constant OR ( seb+sei) .extended 

THEN ErrorDef s.errorsei[varExport, sei]; 
IF -TypePackDef s. As sign able Types [ 
[iBase, iBase.UnderType[( iBase. seb+iSei). id type]]» 
[dataPtr.ownSymbols, UnderType[( seb+sei) . id type]]] 
THEN ErrorDef s.errorsei[exportClash, sei]; 
link ^ RelocateEPLink[ 

IF XferMode[(seb+sei) . idtype] « program 
THEN MakeFrameLink[ep:0, gfi:0] 
ELSE (seb+sei) . idvalue, 
OwnGfi]; 
nltems <- nltems + 1; 
END 
ELSE 

IF sei # SENull AND (seb+sei ) .ctxnum « dataPtr.mainCtx 
AND TypePackDef s .AssignableTypes[ 
[iBase, iBase. UnderType[( iBase. seb+iSei) .idtype]], 
[dataPtr.ownSymbol s, UnderType[( seb+sei) .idtype]]] 
THEN ErrorDef s .WarningSei[privateExport, sei]; 
CompilerDef s .AppendBCDWord[l ink]; 
END; 
ENDLOOP; 
CopierDef s.FreeSymbol Tab le[ iBase]; 

IF nltems = THEN ErrorDef s .WarningSei[unusedExport, id]; 
END; 
END; 
ENDCASE; 
RETURN [t] 
END; 

ProcessExports: PUBLIC TreeDef s .TreeMap « 
BEGIN 

offset: CARDINAL = CompilerDef s . ReadBCDOffset[] ; 
bcdHeader.nExports ♦- TreeDef s. 1 istlength[t]; 
bcdHeader.expOffset <- offset; 
V <- TreeDef s. update! ist[t, ExportId]; 

bcdHeader.expLimit *- LOOPHOLE[CompilerDef s .ReadBCDOff set[]-of f set] ; 
RETURN 
END; 

-- initial ization/f inal ization 

ProcessFiles: PROCEDURE « 
BEGIN 

ftEntry: BcdDef s .FTRecord; 
mdi: MOIndex; 

offset: CARDINAL » CompilerDef s . ReadBCDOff set[] ; 
bcdHeader .f tOff set *- offset; 
FOR mdi <- firstPorted, ffldi+SIZE[MDRecord] UNTIL mdi - lastPorted 

DO 

ftEntry <- [name: EnterFileId[mdi] , version: (mdb+mdi ) .mdStamp]; 

CompilerDefs.AppendBCDWords[@ftEntry, SIZE[BcdDefs .FTRecord]]; 

ENDLOOP; 
bcdHeader. ftLimit <- LOOPHOLE[CompilerDefs. ReadBCDOff set[] - offset]; 
RETURN 
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END; 

MTRootSize: CARDINAL - SIZE[BcdDef s .MTRecord]-SIZE[BcdDef s . FrameFrag] ; 

InitBCD: PUBLIC PROCEDURE - 
BEGIN OPEN BcdDefs; 
lastPorted ^ firstPorted; 

nString <- LOOPHOLE[SysteniDef s.AnocateHeapString[64]]; 
-- allocate the null name 

nString. string. length ♦- BcdDefs .Nul IName; 

nString.size[BcdDefs.NunName] ♦- 0; 
CompilerDefs.StartBCD[]; 
bcdHeader <- SystemDef s .Al locateHeapNode[SIZE[BCD]] ; 

bcdHeader . versionident ^ VersionID; 

bcdHeader. version <- dataPtr .objectVersion ; 

bcdHeader .sourceVersion <- dataPtr. sourceVersion; 

bcdHeader. creator ^ dataPtr. compilerVersion; 

bcdHeader. bound *- \/ersionStainp[zapped:FALSE, net:0, host:0, time:[0,0]]; 

bcdHeader. nConfigs ♦- 0; 

bcdHeader. nModules ♦- 1; 

bcdHeader . nimports *- bcdHeader. nExports ^ 0; 

bcdHeader .definitions *- dataPtr. definitionsOnly; 

bcdHeader. ctOffset <- 0; bcdHeader .ctLimit <- LOOPHOLE[0]; 

nString. string. length <- nString. string. length + 1; 

bcdHeader .source <- NameRecord[nString. string, length] ; 

nString. size[bcdHeader .source] <- dataPtr . sourceFile. length; 
StringDef s .AppendString [©nString. string, dataPtr. sourceFile]; 
bcdOffset *■ CompilerDefs.ReadBCDOffsetC]; 
CompilerDefs.AppendBCDWords[ bcdHeader, SIZE [BCD]]; 
dataPtr. fixupLoc <- CompilerDef s .ReadBCDIndex[]; 
bcdHeader . sgOf f set <- CompilerDefs.ReadBCDOffset[]; 
ConipilerDefs.AppendBCDWords[@dataPtr .codeSeg, SIZE[SGRecord]]; 
CompilerDefs.AppendBCDWords[@dataPtr.syniSeg, SIZE[SGRecord]]; 
bcdHeader .mtOff set <- mtOffset ^ CompilerDef s . ReadBCDOffset[]; 
bcdHeader. sgLimit ♦- LOOPHOLE[mtOf f set - bcdHeader .sgOffset]; 
CompilerDefs.AppendBCDWords[@dataPtr .mtRoot, MTRootSize]; 
RETURN 
END; 

FinishBCD: PUBLIC PROCEDURE » 
BEGIN OPEN BcdDefs; 

PageSize: CARDINAL » Al toDef s . PageSize; 
bcdSize: CARDINAL; 
-- fill MTRecord 

dataPtr .mtRoot. name <- EnterSymbol Id[(bb+dataPtr .mainBody) . id]; 

dataPtr .mtRoot.namedinstance ♦- FALSE; 

dataPtr. mtRoot. initial ^ FALSE; 

dataPtr .mtRoot. file ♦- dataPtr .codeSeg. file ♦- dataPtr .symSeg. file <- 
PortedFile[dataPtr .mainCtx] ; 

dataPtr .mtRoot. 1 inks ♦- frame; 

dataPtr.mtRoot.conf ig *- CTNull; 

dataPtr. mtRoot. code *- 
CodeDesc[ 

sgi: FIRST[SGIndex], 

packed: FALSE, linkspace: FALSE, 

offset: 0. length: ]; 

dataPtr. mtRoot. sseg ♦- FIRST[SGIndex] + SIZE[SGRecord]; 
bcdHeader .mtLimit ^ LOOPHOLE[bcdHeader . impOffset-bcdHeader. mtOffset]; 
ProcessFiles[]; 

bcdHeader .ssOffset ^ CompilerDef s.ReadBCDOffset[]; 
CompilerDef s.AppendBCDStr in g[6nString. string]; 
bcdSize <- CompilerDef s .ReadBCDOffset[] ; 

bcdHeader .ssLimit *- LOOPHOLE[bcdSize-bcdHeader. ssOffset] ; 
bcdHeader .nPages <- (bcdSize + {PageSize-l))/PageSize; 
CompilerDefs.UpdateBCDWords[bcdOffset, bcdHeader, SIZE[BCD]]; 
CompilerDefs.EndBCD[]; 

SystemDef s . FreeHeapString[0nSt ring. string]; 
SystemDef s.FreeHeapNode[ bcdHeader]; 
RETURN 
END; 

END. 



